﻿/// /////////////////////////////////////////////
// 单元名 : unitNetProcObj
// 作者 : Hawk
// 单元描述 : 服务对象之网络对象
// 日期 : 2023-09-15
/// /////////////////////////////////////////////

{$IFDEF FPC}
{$H+}
{$MODE DELPHI}
{$ENDIF}
unit unitNetProcObj;

interface

uses Windows, WinSock2, unitCommonDataStruct, unitDDLinkList, unitObjBase, unitMsgIOCPObj, unitIOCPTCPBase, unitMsgObj,
  unitIOCPUDPBase, unitObjPool, unitAAACommon, unitIOCPFile, unitNetCommon, unitRouteTable, unitIOCPNetBase,
  unitIOCPBaseObj, unitCommonTypes;

type
  TPathMonitorReqObj = record
    PathMonitor: TIOCPPathMonitor;
    Requesters: TObjIDArr;
  end;

  TNetProcObj = class(TMajorObjBase)
  private
    FRouteTbl: TRouteTable;
    FRegedDevTbl: TStoreList;
    FRuntimeAccountTable: TStoreList;
    FHostCnt: array [1 .. 254] of TMsgClientTCP;
    FPathMonitorReqs: array of TPathMonitorReqObj;
    FMsgUDP: TMsgClientUDP;
    FDefUser: TLoginObj;
    FCurTick: Longword;
    FLostRootTick, FLostRootCount: Longword;
    FAllowTCP, FAllowUDP, FIMRoot: Boolean;

    function FindRouteAccInfo(const hid: TID_HOST): TLoginObj;
    function QueryHostStatus(const hid: TID_HOST): THostStatus;
    function QueryHostRTAccount(const hid: TID_HOST): TRunTimeAccount;
    function CanAddDev(pnt: TSerialObj; const sid, uid: TID_OBJ; var Obj, ExistObj: TSerialObj): ERRCODE;
    function CanDelDev(Obj: TSerialObj; const sid, uid: TID_OBJ): ERRCODE;
    function FindDevice(const hid: TID_HOST): TDeviceDesc;
    procedure CreateSessionID(var id: TID_OBJ);
    procedure StartLocalListen;
    procedure StopAll;
    procedure ProcConnectRoot;
    procedure NetObjDirectMsg(NetObj: TObject; m: TMsg; Break: Boolean);
    procedure ProcMsgAsRoot(NetObj: TObject; cp: TConnProtocol; rip: Longword; rpt: Word; msg: TMsg);
    procedure ProcMsgAsPeer(NetObj: TObject; msg: TMsg);
    procedure RecvTCPMsg(Sender: TObject; msg: TMsg);
    procedure UDPStatusChange(Sender: TMsgClientUDP; Peer: TMsgUDPPeer);
    procedure RecvUDPMsg(Sender: TObject; Peer: TMsgUDPPeer; msg: TMsg);
    procedure MsgCntConnected(Sender: TIOCPTcpClient);
    procedure MsgCntProtocolFail(Obj: TIOCPNetBase; ErrorCode: ERRCODE; ErrParam: array of const);
    procedure MsgCntBreak(Sender: TIOCPTcpClient);
    procedure PathChanged(Sender: TObject; ct: TFileChangeType; oldfilename, newfilename: string);
    procedure PathMonitorDeled(IOCPObj: TIOCPObjBase);
    procedure MsgOverTime(Sender: TObject; msg: TMsg);
    procedure MuchIOCPExcept(Sender: TObject; counts: Longword);
    procedure AddDeviceToRegedDevice(const hid: TID_HOST; HostName: CommonString);
    procedure AddDeviceToCommonHost(const hid: TID_HOST; HostName, FriendName: CommonString);
    procedure RegedDeviceChanged(Sender: TObject; ParObj, Obj: TSerialObj; const sid, uid: TID_OBJ);
    procedure RouteAccChanged(Sender: TObject; ParObj, Obj: TSerialObj; const sid, uid: TID_OBJ);
    procedure RouteAccDeled(Sender: TObject; Obj: TSerialObj; const sid, uid: TID_OBJ);
    procedure ReqSyncRemoteTable(const hid: TID_HOST; const tid: TID_OBJ);

    procedure ProcGetQueryObj(msg: TMsg);
    procedure ProcTimer(msg: TMsg);
    procedure ProcRecvSvrInfo(msg: TMsg);
    procedure ProcDirectConn(msg: TMsg);
    procedure ProcRootStatusChange(msg: TMsg);
    procedure ProcFileTask(msg: TMsg);
    procedure ProcRequestHostInfo(msg: TMsg);
    procedure ProcTryConnect(msg: TMsg);
    procedure ProcRouteFailed(msg: TMsg);
    procedure ProcRouteSucced(msg: TMsg);
    procedure ProcAddPathMonitor(msg: TMsg);
    procedure ProcDelPathMonitor(msg: TMsg);
    procedure ProcRegDebugHost(msg: TMsg);
    procedure ProcUnRegDebugHost(msg: TMsg);
  protected
    function DoProcessMsg(msg: TMsg): Boolean; override;
    procedure DoInit(DrationLastShutdowm: Longword); override;
    procedure DoInit2; override;
    procedure DoFinal; override;
  public
    class function ClassID: Longword; override;
    function IndependenceExecThread: Boolean; override;
    procedure SetProperty(PropertyName, PropertyValue: CommonString); override;

    procedure Reset; override;
    procedure Return; override;
  end;

implementation

uses SysUtils, unitCommonIntf, unitIOCP, unitIOCPDataObj, unitMisc, unitClassIDDef, unitLogCommon, unitCommonMsgProc,
  unitMsgDef, unitSvrMngCommon, unitUniqueDataCommon, unitERRCODEDef, unitDebugObj, unitFileAndTransCommon;

const
  S_NETPROPERTY_USERNAME = 'username';
  S_NETPROPERTY_PASSWORD = 'password';
  S_NETPROPERTY_STARTTCP = 'allowtcp';
  S_NETPROPERTY_STARTUDP = 'allowudp';
  L_RECONNROOT = 3;
  L_MILLISECOND = 2;
  S_NETCONFIG_FILENAME = 'Net.config';
  S_DEVHISTORY_FILENAME = 'DevHistory.config';

procedure TNetProcObj.AddDeviceToCommonHost(const hid: TID_HOST; HostName, FriendName: CommonString);
var
  tmp: THostFriendInfo;
begin
  if not hid.IsEmpty then
  begin
    tmp := ObjPool.GetObj(THostFriendInfo, Self);
    tmp.ObjID := MakeObjID(hid, EMPTY_ID_MODULE);
    tmp.HostName := HostName;
    tmp.FriendName := FriendName;
    AddRecord(ID_COMMONUSEHOSTTABLE, tmp);
  end;
end;

procedure TNetProcObj.AddDeviceToRegedDevice(const hid: TID_HOST; HostName: CommonString);
var
  dd: TDeviceDesc;
begin
  dd := ObjPool.GetObj(TDeviceDesc, Self);
  dd.ObjID := MakeObjID(hid, SVRMNGMODULE_ID);
  dd.Caption := HostName;
  AddRecord(ID_REGEDDEVTABLE, dd);
end;

function TNetProcObj.CanAddDev(pnt: TSerialObj; const sid, uid: TID_OBJ; var Obj, ExistObj: TSerialObj): ERRCODE;
var
  dd: TDeviceDesc absolute Obj;
  ri: TRouteItem;
begin
  Result := ERRCODE_NOERROR;
  dd.RootConnect := sid.IDDetail.SvrMdl.HostID = HOSTID_ROOT;
  ri := FRouteTbl.QueryRouteObjByHost(dd.ObjID.IDDetail.SvrMdl.HostID);
  dd.DirectConnect := (ri <> nil) and (ri.Status = rsNormal);
end;

function TNetProcObj.CanDelDev(Obj: TSerialObj; const sid, uid: TID_OBJ): ERRCODE;
var
  dd: TDeviceDesc absolute Obj;
begin
  if sid.IDDetail.SvrMdl.HostID = HOSTID_ROOT then
    dd.RootConnect := False;
  if dd.AllBreak then
    Result := ERRCODE_NOERROR
  else
    Result := ERRCODE_OPECANCELED;
end;

class function TNetProcObj.ClassID: Longword;
begin
  Result := CLASSID_NETPROCOBJ;
end;

procedure TNetProcObj.CreateSessionID(var id: TID_OBJ);
begin
  if (id.IDDetail.ObjType <> OBJTYPE_SESSION) or (FCurTick - id.IDDetail.SubID.GenTime > L_SESSIONALIVE) then
    id := GenSessionID(FCurTick);
end;

procedure TNetProcObj.DoFinal;
begin
  Dbg('Enter Net Final;', L_DBGLEVEL_OUTPUT);
  ObjPool.ReturnChildObj(FRegedDevTbl, Self);
  FRouteTbl.SvrStop;
  StopAll;
  StopIOCP;
  Dbg('Leave Net Final;', L_DBGLEVEL_OUTPUT);
  inherited;
end;

procedure TNetProcObj.DoInit;
var
  s: CommonString;
begin
  Dbg('Enter Net Init;', L_DBGLEVEL_OUTPUT);
  FIMRoot := TObjRoot(Parent).HostID = HOSTID_ROOT;
  ReqAAAQueryObj;
  InitWinSock;
  StartIOCP(1);
  InitFileMngObj(IOCPThreadMgr.GetIOCPThread(0));
  FillChar(FHostCnt, SizeOf(FHostCnt), 0);
  LoadLogStrFile(Self, 'net_log.txt');
  if not FIMRoot then
    LoadLogStrFile(Self, 'aaa_log.txt');
  TObjRoot(Root).RegWANObj(Self);
  FRouteTbl.DevName := unitMisc.DevName;
  FRouteTbl.SetNetRoot(IOCPThreadMgr.GetIOCPThread(0));
  FRouteTbl.AddDeviceToFriendTable := AddDeviceToCommonHost;
  FRouteTbl.SetSelfHostID(Self, TObjRoot(Root).HostID);
  IOCPThreadMgr.GetIOCPThread(0).OnIOCPTick := FRouteTbl.IOCPTick;
  StartLocalListen;
  FRouteTbl.SetUDP(FMsgUDP);
  ObjPool.ReturnChildObj(FRegedDevTbl, Self);
  FRegedDevTbl.CanAddRecord := CanAddDev;
  FRegedDevTbl.CanDelRecord := CanDelDev;
  ObjTree.AddObjEntry(FRegedDevTbl);
  ObjTree.AddObjEntry(FRuntimeAccountTable);
  s := GetStorePath(True);
  RegTableCB(ID_ROUTEACCOUNTTABLE, S_ROUTEACCOUNTTABLE, s + S_NETCONFIG_FILENAME, TStoreList, nil, nil, nil, nil, nil,
    RouteAccChanged, RouteAccDeled);
  if FIMRoot then
    RegTableCB(ID_DEVHISTORYTABLE, S_DEVHISTORYTABLE, s + S_DEVHISTORY_FILENAME, TStoreList, nil, nil, nil, nil, nil,
      nil, nil);
  FRouteTbl.WriteBufSizePerConn := 500 * 1024 * 1024;
  Dbg('Leave Net Init;', L_DBGLEVEL_OUTPUT);
  inherited;
end;

procedure TNetProcObj.DoInit2;
begin
  InitResource(ID_REGEDDEVTABLE, MASK_ALL, 0, S_REGEDDEVTABLE);
  InitPriorityAllOpe(ID_REGEDDEVTABLE, OBJID_SVRMODULE, S_REGEDDEVTABLE);
  if FIMRoot then
  begin
    InitPriorityAllOpe(ID_REGEDDEVTABLE, MASK_LOCALALLUID, S_REGEDDEVTABLE);
    InitPriority(ID_REGEDDEVTABLE, MASK_ALLHOSTMODULE, S_REGEDDEVTABLE, MESID_OPERATOR_ACCESS or
      MESID_OPERATOR_ACCESSSUB);
    InitPriority(ID_REGEDDEVTABLE, MASK_ALLHOSTUID, S_REGEDDEVTABLE, MESID_OPERATOR_ACCESS or MESID_OPERATOR_ACCESSSUB);
    AddDeviceToRegedDevice(HOSTID_ROOT, S_HOSTROOT);
    FRouteTbl.NotifyRootStatus(I_ROUTESTATUS_LOGINED, ERRCODE_NOERROR);
    InitResource(ID_DEVHISTORYTABLE, MASK_ALL, 0, S_DEVHISTORYTABLE);
    InitPriorityAllOpe(ID_DEVHISTORYTABLE, OBJID_SVRMODULE, S_DEVHISTORYTABLE);
    InitPriorityAllOpe(ID_DEVHISTORYTABLE, ID_USERROOT_ROOTHOST, S_DEVHISTORYTABLE);
  end
  else
  begin
    InitPriority(ID_REGEDDEVTABLE, MASK_LOCALALL, S_REGEDDEVTABLE, MESID_OPERATOR_ACCESS or MESID_OPERATOR_ACCESSSUB);
    AddDeviceToRegedDevice(HOSTID_ROOT, S_LOCALHOST);
    AddDeviceToCommonHost(HOSTID_ROOT, S_HOSTROOT, S_HOSTROOT);
    FLostRootTick := L_RECONNROOT;
  end;
  InitResource(ID_RUNTIMEACCOUNTTABLE, MASK_ALL, 0, S_RUNTIMEACCOUNTTABLE);
  InitPriorityLocalModule(ID_RUNTIMEACCOUNTTABLE, S_RUNTIMEACCOUNTTABLE);
  InitResource(ID_ROUTEACCOUNTTABLE, MASK_ALL, 0, S_ROUTEACCOUNTTABLE);
  InitPriorityLocalModule(ID_ROUTEACCOUNTTABLE, S_ROUTEACCOUNTTABLE);
  AddDeviceToRegedDevice(FRouteTbl.SelfHostID, S_LOCALHOST);
  DebugObj(ID_REGEDDEVTABLE);
  inherited;
end;

function TNetProcObj.DoProcessMsg(msg: TMsg): Boolean;
var
  i: integer;
  m: TMsg;
  oid: TID_OBJ;
  s: Boolean;
begin
  Result := True;
  if HostIsMe(msg.TargetObjID.IDDetail.SvrMdl.HostID) then
    case msg.TargetObjID.IDDetail.SvrMdl.Svr of
      0:
        if msg.TargetObjID.IDDetail.SvrMdl.ModuleID.ModuleID = ModuleID.ModuleID then
          case msg.MsgID of
            MESID_ALL_TIMER:
              ProcTimer(msg);
            MESID_ALL_REG_DEBUG:
              ProcRegDebugHost(msg);
            MESID_ALL_UNREG_DEBUG:
              ProcUnRegDebugHost(msg);
            MESID_ALL_ROOTSTATUSCHANGED:
              ProcRootStatusChange(msg);
            MESID_NET_GETQUERYOBJ:
              ProcGetQueryObj(msg);
            MESID_NET_GETFILEMNG:
              ReturnMsg1(msg, MESID_NET_RETURNFILEMNG, nil, 0, FileMng);
            MESID_NET_REQUESTDIRECTCONNECT:
              ProcDirectConn(msg);
            // MESID_NET_CHANGEACCOUNT:
            // ProcChangeAccount(msg);
            MESID_SVRMNG_BROADCASTSVRINFO:
              ProcRecvSvrInfo(msg);
            MESID_NET_NEWFILETASK:
              ProcFileTask(msg);
            MESID_NET_FETCHHOSTINFO:
              ProcRequestHostInfo(msg);
            MESID_NET_TRYCONNECT:
              ProcTryConnect(msg);
            MESID_NET_ROUTEFAILED:
              ProcRouteFailed(msg);
            MESID_NET_ROUTESUCCED:
              ProcRouteSucced(msg);
            MESID_NET_ADDPATHMONITOR:
              ProcAddPathMonitor(msg);
            MESID_NET_DELPATHMONITOR:
              ProcDelPathMonitor(msg);
          else
            Result := inherited;
          end;
      255:
        begin
          s := False;
          for i := Low(FHostCnt) to High(FHostCnt) do
            if FHostCnt[i] <> nil then
            begin
              m := TMsg(msg.Clone);
              oid := m.TargetObjID;
              oid.IDDetail.SvrMdl.Svr := i;
              m.TargetObjID := oid;
              FHostCnt[i].SendMsg(m);
              s := True;
            end;
          if not s then
          begin
            ReturnMsg(msg, MESID_NET_ROUTEFAILED, msg, msg.MsgID);
            Result := False;
          end;
        end;
    else
      if (FHostCnt[msg.TargetObjID.IDDetail.SvrMdl.Svr] <> nil) then
        FHostCnt[msg.TargetObjID.IDDetail.SvrMdl.Svr].SendMsg(msg)
      else
      begin
        ReturnMsg(msg, MESID_NET_ROUTEFAILED, msg, msg.MsgID);
        Result := False;
      end;
    end
  else
  begin
    FRouteTbl.SendMsg(msg);
    Result := False;
  end;
end;

function TNetProcObj.FindDevice(const hid: TID_HOST): TDeviceDesc;
begin
  Result := TDeviceDesc(FRegedDevTbl.Item[0]);
  while Result <> nil do
  begin
    if Result.ObjID.IDDetail.SvrMdl.HostID = hid then
      Break;
    Result := TDeviceDesc(Result.Next);
  end;
end;

function TNetProcObj.FindRouteAccInfo(const hid: TID_HOST): TLoginObj;
begin
  Result := TLoginObj(ObjTree.FindObj(MakeLoginObjID(hid), TLoginObj.ClassID));
end;

procedure TNetProcObj.MsgCntBreak(Sender: TIOCPTcpClient);
var
  b: byte;
  id: TID_OBJ;
begin
  if Sender.RemoteIPNet = L_LOCALIP then
  begin
    b := Longword(Sender.data);
    if FHostCnt[b] = Sender then
    begin
      id.Empty;
      id.IDDetail.SvrMdl.Svr := b;
      MajorBroadcast(id, MESID_NET_CLIENTBREAK);
      FHostCnt[b] := nil;
    end;
  end;
end;

procedure TNetProcObj.MsgCntConnected(Sender: TIOCPTcpClient);
var
  msgcnt: TMsgClientTCP absolute Sender;
  i: integer;
  m: TMsg;
begin
  if msgcnt.RemoteIPNet = L_LOCALIP then
  begin
    for i := Low(FHostCnt) to High(FHostCnt) do
      if FHostCnt[i] = nil then
      begin
        msgcnt.MaxBufSize := 50 * 1024 * 1024;
        msgcnt.data := Pointer(i);
        FHostCnt[i] := msgcnt;
        m := GetAMsg;
        m.TargetObjID := MakeObjID(OBJTYPE_ENTITY, i, FRouteTbl.SelfHostID, EMPTY_ID_MODULE);
        m.MsgID := MESID_NET_SETUIINFO;
        msgcnt.SendMsg(m);
        m := ObjPool.GetObj(TMsg, Self);
        m.SourceObjID := MakeObjID(OBJTYPE_ENTITY, i, FRouteTbl.SelfHostID, EMPTY_ID_MODULE);
        m.MsgID := MESID_NET_UICONNECTED;
        SendMsg(m);
        Break;
      end;
  end
  else
    msgcnt.IdleTimeOut := 5;
  msgcnt.OnRecvMsg := RecvTCPMsg;
  msgcnt.OnSocketError := MsgCntProtocolFail;
end;

procedure TNetProcObj.MsgCntProtocolFail(Obj: TIOCPNetBase; ErrorCode: ERRCODE; ErrParam: array of const);
var
  net: TMsgClientTCP absolute Obj;
  mup: TMsgUDPPeer absolute Obj;
  rip, ll: Longword;
begin
  if Obj.ClassType = TMsgClientTCP then
  begin
    rip := net.RemoteIPNet;
    ll := LOG_LEVEL_CRITICAL;
  end
  else
  begin
    rip := mup.PeerIP;
    ll := LOG_LEVEL_MESSAGE;
  end;
  case ErrorCode of
    ERRCODE_OVERTIME:
      if (Length(ErrParam) = 1) and (ErrParam[0].VType = vtInteger) then
        SendLog(EMPTY_ID_OBJ, LOGID_NET_OVERTIME, ll, [IPToStr(rip), IntToStr(ErrParam[0].VInteger)]);
    ERRCODE_PROTOCOLFAIL:
      if (Length(ErrParam) = 3) and (ErrParam[0].VType = vtInteger) and (ErrParam[1].VType = vtInteger) then
        SendLog(EMPTY_ID_OBJ, LOGID_NET_PROTOCALFAIL, ll, [IPToStr(rip), IntToHex(ErrParam[0].VInteger),
          IntToStr(ErrParam[1].VInteger), IntToStr(ErrParam[2].VInteger)]);
  end;
end;

procedure TNetProcObj.MsgOverTime(Sender: TObject; msg: TMsg);
var
  m: TMsg;
begin
  m := GetAMsg(msg);
  m.MsgID := MESID_NET_ROUTEFAILED;
  m.Error := ERRCODE_OVERTIME;
  m.data := msg.MsgID;
  SendMsg(m);
  ObjPool.ReturnObj(msg, Self);
end;

procedure TNetProcObj.MuchIOCPExcept(Sender: TObject; counts: Longword);
begin
  Dbg('IOCP Thread report much except(%d/sec)!', [counts], L_DBGLEVEL_CRITICAL);
  SendLog(EMPTY_ID_OBJ, LOGID_NET_MUCHIOCPEXCEPT, LOG_LEVEL_CRITICAL, [IntToStr(counts)]);
  SendMsgToObj(EMPTY_ID_OBJ, MESID_ALL_TERMINATE, 0, nil, ERRCODE_INTERNALERR);
end;

procedure TNetProcObj.PathChanged(Sender: TObject; ct: TFileChangeType; oldfilename, newfilename: string);
var
  i: integer;
  m, mm: TMsg;
  so: TStringObj;
  j: integer;
begin
  for i := Low(FPathMonitorReqs) to High(FPathMonitorReqs) do
    if FPathMonitorReqs[i].PathMonitor = Sender then
    begin
      m := GetAMsg;
      m.MsgID := MESID_NET_FILECHANGENOTIFY;
      so := ObjPool.GetObj(TStringObj, Self);
      so.Caption := oldfilename;
      so.Str := newfilename;
      so.Flag := Longword(ct);
      m.AddObj(so);
      for j := Low(FPathMonitorReqs[i].Requesters) to High(FPathMonitorReqs[i].Requesters) - 1 do
      begin
        mm := TMsg(m.Clone);
        mm.TargetObjID := FPathMonitorReqs[i].Requesters[j];
        SendMsg(mm);
      end;
      m.TargetObjID := FPathMonitorReqs[i].Requesters[High(FPathMonitorReqs[i].Requesters)];
      SendMsg(m);
      Break;
    end;
end;

procedure TNetProcObj.PathMonitorDeled(IOCPObj: TIOCPObjBase);
var
  i: integer;
begin
  for i := Low(FPathMonitorReqs) to High(FPathMonitorReqs) do
    if FPathMonitorReqs[i].PathMonitor = IOCPObj then
    begin
      if High(FPathMonitorReqs) <> i then
        FPathMonitorReqs[i] := FPathMonitorReqs[High(FPathMonitorReqs)];
      SetLength(FPathMonitorReqs, Length(FPathMonitorReqs) - 1);
      Break;
    end;
end;

procedure TNetProcObj.ProcAddPathMonitor(msg: TMsg);
var
  so: TStringObj;
  i: integer;
begin
  while msg.Count > 0 do
  begin
    so := msg.Param(TStringObj);
    if so <> nil then
    begin
      so.Str := RegularPath(so.Str);
      Dbg('%s req to monitor path: %s', [msg.SourceObjID.ToString, so.Str]);
      i := High(FPathMonitorReqs);
      while i >= 0 do
      begin
        if LowerCase(FPathMonitorReqs[i].PathMonitor.MonitoredPath) = LowerCase(so.Str) then
        begin
          AddToIDArr(FPathMonitorReqs[i].Requesters, msg.SourceObjID);
          Break;
        end;
        Dec(i);
      end;
      if i = -1 then
      begin
        i := Length(FPathMonitorReqs);
        SetLength(FPathMonitorReqs, i + 1);
        FPathMonitorReqs[i].PathMonitor := ObjPool.GetObj(TIOCPPathMonitor, Self);
        TIOCPThread(IOCPThreadMgr.Item[IOCPThreadMgr.Count - 1]).AddIOCPObj(FPathMonitorReqs[i].PathMonitor);
        FPathMonitorReqs[i].PathMonitor.Flag := so.Flag;
        FPathMonitorReqs[i].PathMonitor.OnFileChangeNotify := PathChanged;
        FPathMonitorReqs[i].PathMonitor.OnIOCPObjDelete := PathMonitorDeled;
        AddToIDArr(FPathMonitorReqs[i].Requesters, msg.SourceObjID);
        FPathMonitorReqs[i].PathMonitor.SetMonitorPath(so.Str);
      end;
      ObjPool.ReturnObj(so, Self);
    end
    else
      Break;
  end;
end;

procedure TNetProcObj.ProcConnectRoot;
begin
  if FIMRoot then
    FRouteTbl.NotifyRootStatus(I_ROUTESTATUS_LOGINED, ERRCODE_NOERROR)
  else
    FRouteTbl.StartConnRoot(FindRouteAccInfo(HOSTID_ROOT));
end;

procedure TNetProcObj.ProcDelPathMonitor(msg: TMsg);
var
  so: TStringObj;
  i: integer;
begin
  while msg.Count > 0 do
  begin
    so := msg.Param(TStringObj);
    if so <> nil then
    begin
      so.Str := RegularPath(so.Str);
      for i := Low(FPathMonitorReqs) to High(FPathMonitorReqs) do
        if FPathMonitorReqs[i].PathMonitor.MonitoredPath = so.Str then
        begin
          DelFromIDArr(FPathMonitorReqs[i].Requesters, msg.SourceObjID);
          if Length(FPathMonitorReqs[i].Requesters) = 0 then
            FPathMonitorReqs[i].PathMonitor.DeleteObj;
          Break;
        end;
      ObjPool.ReturnObj(so, Self);
    end
    else
      Break;
  end;
end;

procedure TNetProcObj.ProcDirectConn(msg: TMsg);
var
  ri, ris: TRouteItem;
  so: TStringObj;
  dd: TDeviceDesc;
  UV4, UV6: Word;
  id: TID_OBJ;
begin
  if FIMRoot then
    while msg.Count > 0 do
    begin
      so := msg.Param(TStringObj);
      if (so <> nil) and (so.ObjID.IDDetail.SvrMdl.HostID <> msg.SourceObjID.IDDetail.SvrMdl.HostID) then
      begin
        ri := FRouteTbl.QueryRouteObjByHost(so.ObjID.IDDetail.SvrMdl.HostID);
        if ri = nil then
          ReturnMsg(msg, MESID_NET_RESP_REQUESTDIRECTCONNECT, so, 0, ERRCODE_OBJNOTEXIST)
        else
        begin
          Dbg('%s request to connect %s', [msg.SourceObjID.IDDetail.SvrMdl.HostID.ToStr,
            so.ObjID.IDDetail.SvrMdl.HostID.ToStr]);
          ris := FRouteTbl.QueryRouteObjByHost(msg.SourceObjID.IDDetail.SvrMdl.HostID);
          if ris <> nil then
          begin
            id := ris.SelfSessionID;
            CreateSessionID(id);
            ris.SelfSessionID := id;
            dd := ObjPool.GetObj(TDeviceDesc, Self);
            dd.ObjID := so.ObjID;
            dd.IPV4 := ri.PeerIP;
            dd.AnnounceIPV4 := ri.PeerAnnounceIP;
            id := ri.SelfSessionID;
            CreateSessionID(id);
            ri.SelfSessionID := id;
            ri.GetPeerUdpPort(UV4, UV6);
            dd.UdpPortV4 := UV4;
            dd.UdpPortV6 := UV6;
            dd.SelfSessionID := ris.SelfSessionID;
            dd.PeerSessionID := ri.SelfSessionID;
            ReturnMsg(msg, MESID_NET_TRYCONNECT, dd);

            dd := ObjPool.GetObj(TDeviceDesc, Self);
            dd.ObjID := msg.SourceObjID;
            dd.IPV4 := ris.PeerIP;
            dd.AnnounceIPV4 := ris.PeerAnnounceIP;
            ris.GetPeerUdpPort(UV4, UV6);
            dd.UdpPortV4 := UV4;
            dd.UdpPortV6 := UV6;
            dd.SelfSessionID := ri.SelfSessionID;
            dd.PeerSessionID := ris.SelfSessionID;
            SendMsgToObj(MakeObjID(ri.PeerHostID, SVRMODULE_ID), MESID_NET_TRYCONNECT, [dd]);
          end;
          ObjPool.ReturnObj(so, Self);
        end;
      end
      else
        Break;
    end;
end;

procedure TNetProcObj.ProcFileTask(msg: TMsg);
var
  ri: TRouteItem;
begin
  ri := FRouteTbl.QueryRouteObjByHost(msg.ObjID.IDDetail.SvrMdl.HostID);
  if ri <> nil then
    ri.AddFileTask(msg.ConnObj)
  else
    ReturnMsg2(msg, MESID_NET_NEWFILETASK2RESP, msg.ObjID, EMPTY_ID_OBJ, [], 0, ERRCODE_ROUTEFAILURE);
end;

procedure TNetProcObj.ProcGetQueryObj(msg: TMsg);
var
  o: TNetQueryObj;
begin
  o := ObjPool.GetObj(TNetQueryObj, Self);
  o.QueryRouteStatus := QueryHostStatus;
  o.QueryRuntimeAccount := QueryHostRTAccount;
  ReturnMsg(msg, MESID_NET_SENDQUERYOBJ, o);
end;

procedure TNetProcObj.ProcTimer;
begin
  FCurTick := msg.data;
  FRouteTbl.Clock(msg.data);
  if IOCPThreadMgr <> nil then
    IOCPThreadMgr.Clock;
  if FLostRootTick > 0 then
  begin
    ShowTopMsg(IntToStr(FLostRootTick) + ' 秒以后连接根主机');
    Dbg('%d seconds to connect Root', [FLostRootTick]);
    Dec(FLostRootTick);
    if FLostRootTick = 0 then
      ProcConnectRoot;
  end;
end;

procedure TNetProcObj.ProcMsgAsPeer(NetObj: TObject; msg: TMsg);
var
  ri: TRouteItem;
  dd: TDeviceDesc;
  rip: Longword;
  m: TMsg;
begin
  ri := FRouteTbl.QueryRouteObjByHost(msg.SourceObjID.IDDetail.SvrMdl.HostID);
  if ri <> nil then
  begin
    if msg.MsgID = MESID_NET_HOSTIDSUCC then
      ri.PeerVerifiedMe := True
    else
    begin
      dd := msg.Param(TDeviceDesc);
      if dd <> nil then
      begin
        rip := 0;
        if TObject(NetObj).ClassType = TMsgClientTCP then
          rip := TMsgClientTCP(NetObj).RemoteIPNet
        else if TObject(NetObj).ClassType = TMsgUDPPeer then
          rip := TMsgUDPPeer(NetObj).PeerIP;
        Dbg('Peer %s(%s:%s) request to verify it: %s', [msg.SourceObjID.IDDetail.SvrMdl.HostID.ToStr, IPToStr(rip),
          IPToStr(ri.PeerAnnounceIP), dd.SelfSessionID.ToString]);
        if ((ri.PeerIP = rip) or (ri.PeerAnnounceIP = rip)) and (ri.PeerSessionID = dd.SelfSessionID) then
        begin
          Dbg('Peer %s verifyed', [msg.SourceObjID.IDDetail.SvrMdl.HostID.ToStr]);
          ri.IVerifiedPeer := True;
          if not ri.PeerVerifiedMe then
          begin
            Dbg('Peer %s not verify me, send request', [msg.SourceObjID.IDDetail.SvrMdl.HostID.ToStr]);
            m := ri.OrgRegMsg;
            NetObjDirectMsg(NetObj, m, False);
            m := GetAMsg;
            m.TargetObjID := MakeObjID(ri.PeerHostID, SVRMODULE_ID);
            m.MsgID := MESID_NET_HOSTIDSUCC;
            NetObjDirectMsg(NetObj, m, False);
          end;
        end;
      end;
    end;
    if ri.PeerVerifiedMe and (ri.IVerifiedPeer) then
      ri.BindNetObj(NetObj, L_DEFAULT_IDLETIME, L_PACKSIZE * 2);
  end;
  ObjPool.ReturnObj(msg, Self);
end;

procedure TNetProcObj.NetObjDirectMsg(NetObj: TObject; m: TMsg; Break: Boolean);
var
  mct: TMsgClientTCP absolute NetObj;
  mup: TMsgUDPPeer absolute NetObj;
begin
  if TObject(NetObj).ClassType = TMsgClientTCP then
  begin
    mct.SendMsg(m);
    if Break then
      mct.DeleteObj;
  end
  else
  begin
    FMsgUDP.SendMsg(mup, m);
    if Break then
      mup.BlockPeer(FRouteTbl.GlobalTickCount);
  end;
  ObjPool.ReturnObj(m, Self);
end;

procedure TNetProcObj.ProcMsgAsRoot(NetObj: TObject; cp: TConnProtocol; rip: Longword; rpt: Word; msg: TMsg);
var
  m: TMsg;
  dd: TDeviceDesc;
  s: string;
  uid: TID_OBJ;
  ri: TRouteItem;
  drh: TDevRegHistory;
begin
  if not msg.SourceObjID.IDDetail.SvrMdl.HostID.IsEmpty and (msg.SourceObjID.IDDetail.SvrMdl.HostID <> HOSTID_ROOT) and
    (msg.TargetObjID.IDDetail.SvrMdl.HostID = HOSTID_ROOT) then
  begin
    dd := msg.Param(TDeviceDesc);
    if dd <> nil then
    begin
      uid := MakeDevHistoryID(msg.SourceObjID.IDDetail.SvrMdl.HostID);
      drh := TDevRegHistory(ObjTree.FindObj(uid, TDevRegHistory.ClassID));
      if (drh = nil) or (not dd.SelfSessionID.IsEmpty and (drh.CPUID = dd.SelfSessionID)) then
      begin
        if drh = nil then
        begin
          drh := ObjPool.GetObj(TDevRegHistory, Self);
          drh.ObjID := uid;
          drh.CPUID := dd.SelfSessionID;
        end;
        drh.LastReg := Now;
        AddRecord(ID_DEVHISTORYTABLE, drh);
        uid := UserIDOfSource(msg);
        ri := FRouteTbl.QueryRouteObjByHost(msg.SourceObjID.IDDetail.SvrMdl.HostID);
        if (ri <> nil) and (ri.Status > rsInConnecting) and (ri.PeerIP <> rip) then
        begin
          Dbg('Same device %s exists. cur IP:%s , new req IP: %s', [msg.SourceObjID.IDDetail.SvrMdl.HostID.ToStr,
            IPToStr(ri.PeerIP), IPToStr(rip)]);
          SendLog(uid, LOGID_NET_HOSTREGFAIL, LOG_LEVEL_CRITICAL, [ri.PeerHostID.ToStr, IPToStr(ri.PeerIP),
            IPToStr(rip)]);
          m := GetAMsg(msg);
          m.MsgID := MESID_NET_HOSTIDREGED;
          NetObjDirectMsg(NetObj, m, True);
        end
        else
        begin
          s := '';
          if ri = nil then
          begin
            ri := FRouteTbl.NewRoute(msg.SourceObjID.IDDetail.SvrMdl.HostID);
            ri.PeerIP := rip;
          end;
          dd := msg.Param(TDeviceDesc);
          if dd <> nil then
          begin
            dd.ObjID := MakeObjID(msg.SourceObjID.IDDetail.SvrMdl.HostID, SVRMNGMODULE_ID);
            ri.ProductID := dd.ProductID;
            ri.HostName := dd.DevName;
            ri.DevType := dd.DevType;
            ri.PeerAnnounceIP := dd.AnnounceIPV4;
            AddRecord(ID_REGEDDEVTABLE, dd);
            s := dd.DevName;
            AddDeviceToCommonHost(msg.SourceObjID.IDDetail.SvrMdl.HostID, s, s);
          end;
          m := GetAMsg(msg);
          m.MsgID := MESID_NET_HOSTIDSUCC;
          NetObjDirectMsg(NetObj, m, False);
          ri.BindNetObj(NetObj, L_DEFAULT_IDLETIME, L_PACKSIZE * 2);
          ri.LastOnLine := Now;
          Dbg('Device %s (%s:%s) registered from %s:%s(%s)', [msg.SourceObjID.IDDetail.SvrMdl.HostID.ToStr, s,
            S_DEVICETYPE[ri.DevType], S_CONNPROTOCOL[cp], IPToStr(rip), IPToStr(ri.PeerAnnounceIP)]);
          SendLog(uid, LOGID_NET_HOSTREGED, LOG_LEVEL_MESSAGE, [ri.PeerHostID.ToStr, s, S_CONNPROTOCOL[cp],
            IPToStr(ri.PeerIP)]);
        end;
      end
      else
        SendLog(EMPTY_ID_OBJ, LOGID_NET_ERRORPARAM, LOG_LEVEL_CRITICAL,
          [msg.SourceObjID.ToString, dd.SelfSessionID.ToString]);
    end
    else
      SendLog(EMPTY_ID_OBJ, LOGID_NET_INVALIDPARAM, LOG_LEVEL_CRITICAL, [msg.SourceObjID.ToString]);
  end;
  ObjPool.ReturnObj(msg, Self);
end;

procedure TNetProcObj.ProcTryConnect(msg: TMsg);
var
  dd: TDeviceDesc;
  ri: TRouteItem;
begin
  if msg.SourceObjID.IDDetail.SvrMdl.HostID = HOSTID_ROOT then
    while msg.Count > 0 do
    begin
      dd := msg.Param(TDeviceDesc);
      if dd <> nil then
      begin
        Dbg('Root order to connect %s IP: %s, AnnIP: %s, UDP Port: V4 %d, V6 %d',
          [dd.ObjID.IDDetail.SvrMdl.HostID.ToStr, IPToStr(dd.IPV4), IPToStr(dd.AnnounceIPV4), htons(dd.UdpPortV4),
          htons(dd.UdpPortV6)]);
        if (dd.ObjID.IDDetail.SvrMdl.HostID <> FRouteTbl.SelfHostID) then
        begin
          ri := FRouteTbl.QueryRouteObjByHost(dd.ObjID.IDDetail.SvrMdl.HostID);
          if ri = nil then
          begin
            ri := FRouteTbl.NewRoute(dd.ObjID.IDDetail.SvrMdl.HostID);
            ri.PeerIP := dd.IPV4;
            ri.PeerAnnounceIP := dd.AnnounceIPV4;
            ri.SelfSessionID := dd.SelfSessionID;
            ri.PeerSessionID := dd.PeerSessionID;
            ri.SetBindAccInfo(FindRouteAccInfo(dd.ObjID.IDDetail.SvrMdl.HostID));
            if dd.IPV4 <> 0 then
            begin
              if dd.IPV4 <> FRouteTbl.AnnounceIP then
                ri.AddConnInfo(IPv4TCP, dd.IPV4, W_PORTNET);
              ri.AddConnInfo(IPv4UDP, dd.IPV4, W_PORTNET);
              if dd.UdpPortV4 <> 0 then
                ri.AddConnInfo(IPv4UDP, dd.IPV4, dd.UdpPortV4);
            end;
            if dd.AnnounceIPV4 <> 0 then
            begin
              if dd.AnnounceIPV4 <> FRouteTbl.AnnounceIP then
                ri.AddConnInfo(IPv4TCP, dd.AnnounceIPV4, W_PORTNET);
              ri.AddConnInfo(IPv4UDP, dd.AnnounceIPV4, W_PORTNET);
              if dd.UdpPortV4 <> 0 then
                ri.AddConnInfo(IPv4UDP, dd.AnnounceIPV4, dd.UdpPortV4);
            end;
            ri.StartCommunicate;
          end;
          AddDeviceToCommonHost(dd.ObjID.IDDetail.SvrMdl.HostID, dd.DevName, '');
        end;
        ObjPool.ReturnObj(dd, Self);
      end
      else
        Break;
    end;
end;

procedure TNetProcObj.ProcUnRegDebugHost(msg: TMsg);
begin
  if CommonIntf.DebugHost = msg.SourceObjID then
    CommonIntf.DebugHost.Empty;
end;

function TNetProcObj.QueryHostRTAccount(const hid: TID_HOST): TRunTimeAccount;
var
  ri: TRouteItem;
begin
  ri := FRouteTbl.QueryRouteObjByHost(hid);
  if ri <> nil then
    Result := ri.FillRunTimeAccount
  else
    Result := nil;
end;

function TNetProcObj.QueryHostStatus(const hid: TID_HOST): THostStatus;
var
  ri: TRouteItem;
begin
  if FindDevice(hid) <> nil then
  begin
    if FIMRoot then
      Result := hsDirect
    else
    begin
      Result := hsByRoot;
      ri := FRouteTbl.QueryRouteObjByHost(hid);
      if ri <> nil then
        if ri.RouteStatus and I_ROUTESTATUS_NORMAL <> 0 then
          Result := hsDirect;
    end
  end
  else
    Result := hsNone;
end;

procedure TNetProcObj.ProcRecvSvrInfo(msg: TMsg);
var
  dd: TDeviceDesc;
begin
  dd := msg.Param(TDeviceDesc);
  if dd <> nil then
  begin
    FRouteTbl.ProductID := dd.ProductID;
    FRouteTbl.DevName := dd.DevName;
    FRouteTbl.DevType := dd.DevType;
  end;
end;

procedure TNetProcObj.ProcRegDebugHost(msg: TMsg);
var
  dc: TDebugConfig;
begin
  dc := msg.Param(TDebugConfig);
  if dc <> nil then
  begin
    CommonIntf.DebugHost := msg.SourceObjID;
    CommonIntf.DebugMask := dc.DebugMask;
  end;
end;

procedure TNetProcObj.ProcRequestHostInfo(msg: TMsg);
var
  so: TStringObj;
  ri: TRouteItem;
  dd: TDeviceDesc;
  pv4, pv6: Word;
  rm: TMsg;
begin
  rm := GetAMsg(msg);
  rm.MsgID := MESID_NET_RETURNHOSTINFO;
  while msg.Count > 0 do
  begin
    so := msg.Param(TStringObj);
    if so <> nil then
    begin
      ri := FRouteTbl.QueryRouteObjByHost(so.ObjID.IDDetail.SvrMdl.HostID);
      if ri <> nil then
      begin
        dd := ObjPool.GetObj(TDeviceDesc, Self);
        dd.ObjID := so.ObjID;
        dd.IPV4 := ri.PeerIP;
        dd.AnnounceIPV4 := ri.PeerAnnounceIP;
        ri.GetPeerUdpPort(pv4, pv6);
        dd.UdpPortV4 := pv4;
        dd.UdpPortV6 := pv6;
        rm.AddObj(dd);
      end;
      ObjPool.ReturnObj(so, Self);
    end
    else
      Break;
  end;
  SendMsg(rm);
end;

procedure TNetProcObj.ProcRootStatusChange(msg: TMsg);
var
  dd: TDeviceDesc;
begin
  if msg.data and I_ROUTESTATUS_ROUTED <> 0 then
  begin
    dd := FindDevice(HOSTID_ROOT);
    if dd <> nil then
    begin
      dd.RootConnect := True;
      NotifyRecordUpdated([dd.ObjID]);
    end;
    FLostRootTick := 0;
    FLostRootCount := 0;
    AddDeviceToRegedDevice(HOSTID_ROOT, S_HOSTROOT);
    ReqSyncRemoteTable(HOSTID_ROOT, ID_REGEDDEVTABLE);
  end;
  if msg.data = I_ROUTESTATUS_BREAK then
    DelRecord(MakeObjID(HOSTID_ROOT, EMPTY_ID_MODULE));
end;

procedure TNetProcObj.ProcRouteFailed(msg: TMsg);
var
  ri: TRouteItem;
  dd: TDeviceDesc;
  m: TMsg;
begin
  ri := FRouteTbl.QueryRouteObjByHost(msg.ObjID.IDDetail.SvrMdl.HostID);
  if ri <> nil then
  begin
    dd := FindDevice(msg.ObjID.IDDetail.SvrMdl.HostID);
    if dd <> nil then
    begin
      if FIMRoot then
      begin
        dd.RootConnect := False;
        dd.DirectConnect := False;
      end
      else
      begin
        if msg.ObjID.IDDetail.SvrMdl.HostID = HOSTID_ROOT then
          dd.RootConnect := False
        else
          dd.DirectConnect := False;
      end;
      DelRecord(dd.ObjID);
    end;
    // DelRecord(MakeObjID(msg.ObjID.IDDetail.SvrMdl.HostID, EMPTY_ID_MODULE));
    SendLog(LocalRootID, LOGID_NET_HOSTBREAK, LOG_LEVEL_MESSAGE, [ri.PeerHostID.ToStr]);
    ObjPool.ReturnObj(ri, Self);
  end;
  if CommonIntf.DebugHost.IDDetail.SvrMdl.HostID = msg.ObjID.IDDetail.SvrMdl.HostID then
    CommonIntf.DebugHost.Empty;
  if msg.ObjID.IDDetail.SvrMdl.HostID = HOSTID_ROOT then
  begin
    Inc(FLostRootCount);
    Dbg('Lost root count: %d', [FLostRootCount]);
    FLostRootTick := (FLostRootCount mod 10) * 60;
    m := GetAMsg;
    m.SourceObjID := ROOTID_UNIQUEDATAMODULE;
    m.TargetObjID := OBJID_UNIQUEDATAMODULE;
    m.MsgID := MESID_UNIQUEDATA_RESP_DELOBJ;
    dd := TDeviceDesc(FRegedDevTbl.Item[0]);
    while dd <> nil do
    begin
      if dd.ObjID.IDDetail.SvrMdl.HostID <> FRouteTbl.SelfHostID then
      begin
        ri := FRouteTbl.QueryRouteObjByHost(dd.ObjID.IDDetail.SvrMdl.HostID);
        if (ri = nil) or (ri.Status < rsInConnecting) then
          m.AddIDObj(dd.ObjID);
      end;
      dd := TDeviceDesc(dd.Next);
    end;
    SendMsg(m);
  end;
end;

procedure TNetProcObj.ProcRouteSucced(msg: TMsg);
var
  ri: TRouteItem;
  dd: TDeviceDesc;
begin
  ri := msg.ConnObj;
  if ri <> nil then
  begin
    dd := FindDevice(ri.PeerHostID);
    if dd <> nil then
    begin
      dd.DirectConnect := True;
      NotifyRecordUpdated([dd.ObjID]);
    end;
  end;
end;

procedure TNetProcObj.RecvTCPMsg(Sender: TObject; msg: TMsg);
var
  cnt: TMsgClientTCP absolute Sender;
  b: byte;
begin
  if cnt.RemoteIPNet = L_LOCALIP then
  begin
    b := Longword(cnt.data);
    if (FHostCnt[b] = cnt) and (msg.SourceObjID.IDDetail.SvrMdl.Svr = b) then
    begin
      if HostIsMe(msg.TargetObjID.IDDetail.SvrMdl.HostID) then
        SendMsg(msg)
      else
      begin
        ProcConnectRoot;
        FRouteTbl.SendMsg(msg);
      end;
    end
    else
      ObjPool.ReturnObj(msg, Self);
  end
  else if FIMRoot then
    ProcMsgAsRoot(Sender, IPv4TCP, cnt.RemoteIPNet, cnt.RemotePortNet, msg)
  else
    ProcMsgAsPeer(Sender, msg);
end;

procedure TNetProcObj.RecvUDPMsg(Sender: TObject; Peer: TMsgUDPPeer; msg: TMsg);
begin
  if FIMRoot then
    ProcMsgAsRoot(Peer, IPv4UDP, Peer.PeerIP, Peer.PeerPort, msg)
  else
    ProcMsgAsPeer(Peer, msg);
  ObjPool.ReturnObj(msg, Self);
end;

procedure TNetProcObj.RegedDeviceChanged(Sender: TObject; ParObj, Obj: TSerialObj; const sid, uid: TID_OBJ);
var
  dd: TDeviceDesc absolute Obj;
begin
  AddDeviceToCommonHost(dd.ObjID.IDDetail.SvrMdl.HostID, dd.DevName, '');
end;

procedure TNetProcObj.ReqSyncRemoteTable(const hid: TID_HOST; const tid: TID_OBJ);
var
  Str: TSyncTableReq;
begin
  Str := ObjPool.GetObj(TSyncTableReq, Self);
  Str.SyncHostID := hid;
  Str.SyncTableID := tid;
  SendMsgToObj(OBJID_UNIQUEDATAMODULE, MESID_UNIQUEDATA_SYNCOBJ, [Str]);
  DebugObj(tid);
end;

procedure TNetProcObj.Reset;
var
  nis: TNETCARDINFOS;
  i: integer;
begin
  inherited;
  OnlyLocalDbg := True;
  if FRouteTbl = nil then
    FRouteTbl := TRouteTable.Create;
  FRouteTbl.OnMsgOverTime := MsgOverTime;
  if FRegedDevTbl = nil then
  begin
    FRegedDevTbl := ObjPool.GetObj(TStoreList, Self);
    FRegedDevTbl.ObjID := ID_REGEDDEVTABLE;
    FRegedDevTbl.Caption := S_REGEDDEVTABLE;
    FRegedDevTbl.AllowSameName := True;
    FRegedDevTbl.AddRdUpdated(RegedDeviceChanged);
  end;
  if FRuntimeAccountTable = nil then
  begin
    FRuntimeAccountTable := TStoreList.Create;
    FRuntimeAccountTable.ObjID := ID_RUNTIMEACCOUNTTABLE;
    FRuntimeAccountTable.Caption := S_RUNTIMEACCOUNTTABLE;
  end;
  FAllowTCP := True;
  FAllowUDP := True;
  GetNetCardInfos(nis);
  for i := Low(nis) to High(nis) do
    if nis[i].IPV4 <> 0 then
    begin
      FRouteTbl.AnnounceIP := nis[i].IPV4;
      Break;
    end;
end;

procedure TNetProcObj.Return;
begin
  FreeAndNil(FRuntimeAccountTable);
  FreeAndNil(FRegedDevTbl);
  FreeAndNil(FDefUser);
  FRouteTbl.Free;
  FRouteTbl := nil;
  inherited;
end;

procedure TNetProcObj.RouteAccChanged(Sender: TObject; ParObj, Obj: TSerialObj; const sid, uid: TID_OBJ);
var
  lo: TLoginObj absolute Obj;
  ri: TRouteItem;
begin
  ri := FRouteTbl.QueryRouteObjByHost(lo.ObjID.IDDetail.SvrMdl.HostID);
  if ri <> nil then
    ri.SetBindAccInfo(lo);
end;

procedure TNetProcObj.RouteAccDeled(Sender: TObject; Obj: TSerialObj; const sid, uid: TID_OBJ);
var
  ri: TRouteItem;
begin
  ri := FRouteTbl.QueryRouteObjByHost(Obj.ObjID.IDDetail.SvrMdl.HostID);
  if ri <> nil then
    ri.SetBindAccInfo(nil);
end;

function TNetProcObj.IndependenceExecThread: Boolean;
begin
  Result := True;
end;

procedure TNetProcObj.SetProperty(PropertyName, PropertyValue: CommonString);
begin
  if PropertyName = S_NETPROPERTY_USERNAME then
  begin
    if FDefUser = nil then
      FDefUser := ObjPool.GetObj(TLoginObj, Self);
    FDefUser.UserName := PropertyValue;
  end
  else if PropertyName = S_NETPROPERTY_PASSWORD then
  begin
    if FDefUser = nil then
      FDefUser := ObjPool.GetObj(TLoginObj, Self);
    FDefUser.Password := PropertyValue;
  end
  else if PropertyName = S_NETPROPERTY_STARTTCP then
    FAllowTCP := LowerCase(PropertyValue) = S_SWITCH_ON_LOW
  else if PropertyName = S_NETPROPERTY_STARTUDP then
    FAllowUDP := LowerCase(PropertyValue) = S_SWITCH_ON_LOW
  else
    inherited;
end;

procedure TNetProcObj.StartLocalListen;
var
  iocpt: TIOCPThread;
  tsvr: TIOCPTcpServer;
  msp: TMilliSecParam;
begin
  iocpt := IOCPThreadMgr.GetIOCPThread(0);
  iocpt.OnMuchExcept := MuchIOCPExcept;
  if FAllowTCP then
  begin
    tsvr := ObjPool.GetObj(TIOCPTcpServer, Self);
    if tsvr <> nil then
    begin
      if FIMRoot then
        tsvr.AcceptCount := 100;
      iocpt.AddIOCPObj(tsvr);
      tsvr.ClientClassID := TMsgClientTCP.ClassID;
      tsvr.OnTcpConnected := MsgCntConnected;
      tsvr.OnTcpBreak := MsgCntBreak;
      tsvr.Start(I_ROOTPORT);
    end;
  end;
  if FAllowUDP then
  begin
    FMsgUDP := ObjPool.GetObj(TMsgClientUDP, Self);
    if FMsgUDP <> nil then
    begin
      iocpt.AddIOCPObj(FMsgUDP);
      FMsgUDP.OnSocketError := MsgCntProtocolFail;
      FMsgUDP.OnMsgUDPStatusChanged := UDPStatusChange;
      FMsgUDP.OnRecvMsg := RecvUDPMsg;
      FMsgUDP.StartUDP(I_ROOTPORT);
      msp := ObjPool.GetObj(TMilliSecParam, Self);
      msp.IOCPPort := FMsgUDP.IOCPPort;
      msp.IOCPKey := NativeUInt(FMsgUDP);
      msp.IOCPMsg := IOCPEVENT_MILLISEC;
      SendMsgToObj(EMPTY_ID_OBJ, MESID_ALL_REGMILLISECOND, L_MILLISECOND, msp);
    end;
  end;
end;

procedure TNetProcObj.StopAll;
begin

end;

procedure TNetProcObj.UDPStatusChange(Sender: TMsgClientUDP; Peer: TMsgUDPPeer);
begin

end;

initialization

ObjPool.RegisterObjClass(TNetProcObj);

end.
